home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
os2
/
octa209s.zip
/
octave-2.09
/
libcruft
/
minpack
/
fdjac1.f
< prev
next >
Wrap
Text File
|
1996-07-19
|
5KB
|
152 lines
SUBROUTINE FDJAC1(FCN,N,X,FVEC,FJAC,LDFJAC,IFLAG,ML,MU,EPSFCN,
* WA1,WA2)
INTEGER N,LDFJAC,IFLAG,ML,MU
DOUBLE PRECISION EPSFCN
DOUBLE PRECISION X(N),FVEC(N),FJAC(LDFJAC,N),WA1(N),WA2(N)
EXTERNAL FCN
C **********
C
C SUBROUTINE FDJAC1
C
C THIS SUBROUTINE COMPUTES A FORWARD-DIFFERENCE APPROXIMATION
C TO THE N BY N JACOBIAN MATRIX ASSOCIATED WITH A SPECIFIED
C PROBLEM OF N FUNCTIONS IN N VARIABLES. IF THE JACOBIAN HAS
C A BANDED FORM, THEN FUNCTION EVALUATIONS ARE SAVED BY ONLY
C APPROXIMATING THE NONZERO TERMS.
C
C THE SUBROUTINE STATEMENT IS
C
C SUBROUTINE FDJAC1(FCN,N,X,FVEC,FJAC,LDFJAC,IFLAG,ML,MU,EPSFCN,
C WA1,WA2)
C
C WHERE
C
C FCN IS THE NAME OF THE USER-SUPPLIED SUBROUTINE WHICH
C CALCULATES THE FUNCTIONS. FCN MUST BE DECLARED
C IN AN EXTERNAL STATEMENT IN THE USER CALLING
C PROGRAM, AND SHOULD BE WRITTEN AS FOLLOWS.
C
C SUBROUTINE FCN(N,X,FVEC,IFLAG)
C INTEGER N,IFLAG
C DOUBLE PRECISION X(N),FVEC(N)
C ----------
C CALCULATE THE FUNCTIONS AT X AND
C RETURN THIS VECTOR IN FVEC.
C ----------
C RETURN
C END
C
C THE VALUE OF IFLAG SHOULD NOT BE CHANGED BY FCN UNLESS
C THE USER WANTS TO TERMINATE EXECUTION OF FDJAC1.
C IN THIS CASE SET IFLAG TO A NEGATIVE INTEGER.
C
C N IS A POSITIVE INTEGER INPUT VARIABLE SET TO THE NUMBER
C OF FUNCTIONS AND VARIABLES.
C
C X IS AN INPUT ARRAY OF LENGTH N.
C
C FVEC IS AN INPUT ARRAY OF LENGTH N WHICH MUST CONTAIN THE
C FUNCTIONS EVALUATED AT X.
C
C FJAC IS AN OUTPUT N BY N ARRAY WHICH CONTAINS THE
C APPROXIMATION TO THE JACOBIAN MATRIX EVALUATED AT X.
C
C LDFJAC IS A POSITIVE INTEGER INPUT VARIABLE NOT LESS THAN N
C WHICH SPECIFIES THE LEADING DIMENSION OF THE ARRAY FJAC.
C
C IFLAG IS AN INTEGER VARIABLE WHICH CAN BE USED TO TERMINATE
C THE EXECUTION OF FDJAC1. SEE DESCRIPTION OF FCN.
C
C ML IS A NONNEGATIVE INTEGER INPUT VARIABLE WHICH SPECIFIES
C THE NUMBER OF SUBDIAGONALS WITHIN THE BAND OF THE
C JACOBIAN MATRIX. IF THE JACOBIAN IS NOT BANDED, SET
C ML TO AT LEAST N - 1.
C
C EPSFCN IS AN INPUT VARIABLE USED IN DETERMINING A SUITABLE
C STEP LENGTH FOR THE FORWARD-DIFFERENCE APPROXIMATION. THIS
C APPROXIMATION ASSUMES THAT THE RELATIVE ERRORS IN THE
C FUNCTIONS ARE OF THE ORDER OF EPSFCN. IF EPSFCN IS LESS
C THAN THE MACHINE PRECISION, IT IS ASSUMED THAT THE RELATIVE
C ERRORS IN THE FUNCTIONS ARE OF THE ORDER OF THE MACHINE
C PRECISION.
C
C MU IS A NONNEGATIVE INTEGER INPUT VARIABLE WHICH SPECIFIES
C THE NUMBER OF SUPERDIAGONALS WITHIN THE BAND OF THE
C JACOBIAN MATRIX. IF THE JACOBIAN IS NOT BANDED, SET
C MU TO AT LEAST N - 1.
C
C WA1 AND WA2 ARE WORK ARRAYS OF LENGTH N. IF ML + MU + 1 IS AT
C LEAST N, THEN THE JACOBIAN IS CONSIDERED DENSE, AND WA2 IS
C NOT REFERENCED.
C
C SUBPROGRAMS CALLED
C
C MINPACK-SUPPLIED ... DPMPAR
C
C FORTRAN-SUPPLIED ... DABS,DMAX1,DSQRT
C
C MINPACK. VERSION OF JUNE 1979.
C BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C **********
INTEGER I,J,K,MSUM
DOUBLE PRECISION EPS,EPSMCH,H,TEMP,ZERO
DOUBLE PRECISION DPMPAR
DATA ZERO /0.0D0/
C
C EPSMCH IS THE MACHINE PRECISION.
C
EPSMCH = DPMPAR(1)
C
EPS = DSQRT(DMAX1(EPSFCN,EPSMCH))
MSUM = ML + MU + 1
IF (MSUM .LT. N) GO TO 40
C
C COMPUTATION OF DENSE APPROXIMATE JACOBIAN.
C
DO 20 J = 1, N
TEMP = X(J)
H = EPS*DABS(TEMP)
IF (H .EQ. ZERO) H = EPS
X(J) = TEMP + H
CALL FCN(N,X,WA1,IFLAG)
IF (IFLAG .LT. 0) GO TO 30
X(J) = TEMP
DO 10 I = 1, N
FJAC(I,J) = (WA1(I) - FVEC(I))/H
10 CONTINUE
20 CONTINUE
30 CONTINUE
GO TO 110
40 CONTINUE
C
C COMPUTATION OF BANDED APPROXIMATE JACOBIAN.
C
DO 90 K = 1, MSUM
DO 60 J = K, N, MSUM
WA2(J) = X(J)
H = EPS*DABS(WA2(J))
IF (H .EQ. ZERO) H = EPS
X(J) = WA2(J) + H
60 CONTINUE
CALL FCN(N,X,WA1,IFLAG)
IF (IFLAG .LT. 0) GO TO 100
DO 80 J = K, N, MSUM
X(J) = WA2(J)
H = EPS*DABS(WA2(J))
IF (H .EQ. ZERO) H = EPS
DO 70 I = 1, N
FJAC(I,J) = ZERO
IF (I .GE. J - MU .AND. I .LE. J + ML)
* FJAC(I,J) = (WA1(I) - FVEC(I))/H
70 CONTINUE
80 CONTINUE
90 CONTINUE
100 CONTINUE
110 CONTINUE
RETURN
C
C LAST CARD OF SUBROUTINE FDJAC1.
C
END